libraries etc.
library(tidyverse)
library(ggtext)
library(networkD3)
library(d3Network)
library(igraph)
library(plotly)
plotly example
sqa_top5s <- read_csv("sqa_top5s.csv")
##
## ── Column specification ─────────────────────────────────────────────────────────────────────────────────
## cols(
## year = col_double(),
## Subject = col_character(),
## gender = col_character(),
## NoOfStudents = col_double(),
## popularity = col_double(),
## popularityOverTime = col_double(),
## Subject.label = col_character()
## )
time_range <- sqa_top5s %>%
select(year) %>%
n_distinct()
options(repr.plot.width = 18, repr.plot.height = 9)
plot1 <- sqa_top5s %>%
highlight_key(~gender) %>%
ggplot(aes(y = fct_reorder(Subject.label, popularity), x = popularityOverTime,
text = paste(gender, " - choose", Subject, round(popularityOverTime * 100), "% of the time"),
mode = "markers+text")) +
geom_segment(aes(xend = 0, yend = Subject.label), alpha = 0.45) +
geom_point(aes(colour = gender, shape = gender), size = 3) +
scale_shape_manual(values = c(6, 2)) + #-0x2640L, -0x2642L)) + # \u2640 and \u2642
guides(size = FALSE, alpha = FALSE) +
scale_x_continuous(labels = function(x) scales::percent(abs(x)), breaks = seq(0, 1, 0.2)) +
ylab(NULL) + xlab("Frequency - in Top 5 Subjects Over Time (Excluding English & Maths)") +
theme(axis.text.y = element_markdown(size = 14),
axis.text.x = element_text(size = 12, angle = 45, vjust = 0.5),
#text = element_text(family = "Helvetica")
) #%>%
#suppressMessages() %>%
#suppressWarnings() - ignored ...
plot1

ggplotly(plot1, tooltip = "text", dynamicTicks = "x", width = 1800, height = 700,
margin = list(l = 0, r = 5, b = 5, t = 5, pad = 2),
yais = yaxis <- list(automargin = FALSE, margin = list(l = 0, r = 5, b = 5, t = 5, pad = 2))) %>%
style(hoveron = "points", hoverinfo = "text", hoverlabel = list(bgcolor = "white")) %>%
highlight(on = "plotly_hover", off = "plotly_doubleclick") %>%
rangeslider()
plotly update example
library(quantmod)
quantmod::getSymbols("AAPL")
## [1] "AAPL"
df <- data.frame(Date = index(AAPL), coredata(AAPL))
high_annotations <- list(
x = df$Date[df$AAPL.High == max(df$AAPL.High)],
y = max(df$AAPL.High),
xref = 'x', yref = 'y',
text = paste0('High: $',max(df$AAPL.High)),
ax = 0, ay = -40
)
low_annotations <- list(
x = df$Date[df$AAPL.Low == min(df$AAPL.Low)],
y = min(df$AAPL.Low),
xref = 'x', yref = 'y',
text = paste0('Low: $',min(df$AAPL.Low)),
ax = 0, ay = 40
)
# updatemenus component
updatemenus <- list(
list(
active = -1,
type= 'buttons',
buttons = list(
list(
label = "High",
method = "update",
args = list(list(visible = c(FALSE, TRUE)),
list(title = "Apple High",
annotations = list(c(), high_annotations)))),
list(
label = "Low",
method = "update",
args = list(list(visible = c(TRUE, FALSE)),
list(title = "Apple Low",
annotations = list(low_annotations, c() )))),
list(
label = "Both",
method = "update",
args = list(list(visible = c(TRUE, TRUE)),
list(title = "Apple",
annotations = list(low_annotations, high_annotations)))),
list(
label = "Reset",
method = "update",
args = list(list(visible = c(TRUE, TRUE)),
list(title = "Apple",
annotations = list(c(), c())))))
)
)
df %>%
plot_ly(type = 'scatter', mode = 'lines') %>%
add_lines(x = ~Date, y = ~AAPL.High, name = "High", line = list(color = "#33CFA5")) %>%
add_lines(x = ~Date, y = ~AAPL.Low, name = "Low", line = list(color = "#F06A6A")) %>%
layout(title = "Apple", showlegend = FALSE,
xaxis = list(title = "Date"),
yaxis = list(title = "Price ($)"),
updatemenus = updatemenus)
mtcars %>%
highlight_key(~cyl) %>%
plot_ly(
x = ~wt, y = ~mpg, text = ~cyl, mode = "markers+text",
textposition = "top", hoverinfo = "x+y"
) %>%
highlight(on = "plotly_hover", off = "plotly_doubleclick")
## No trace type specified:
## Based on info supplied, a 'scatter' trace seems appropriate.
## Read more about this trace type -> https://plotly.com/r/reference/#scatter
igraph example
data(MisLinks)
data(MisNodes)
forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
#Nodesize = "size",
radiusCalculation = "Math.sqrt(d.nodesize) + 6",
Group = "group", fontSize = 16, opacity = 1, legend = T, bounded = T)
igraph example
# Make a correlation matrix:
mat <- cor(t(mtcars[,c(1,3:6)]))
# Keep only high correlations
mat[mat<0.995] <- 0
# Make an Igraph object from this matrix:
network <- graph_from_adjacency_matrix( mat, weighted=T, mode="undirected", diag=F)
plot(network)

igraph to networkD3 example
# Use igraph to make the graph and find membership
karate <- make_graph("Zachary")
wc <- cluster_walktrap(karate)
members <- membership(wc)
# Convert to object suitable for networkD3
karate_d3 <- igraph_to_networkD3(karate, group = members)
# Create force directed network plot
forceNetwork(Links = karate_d3$links, Nodes = karate_d3$nodes,
Source = 'source', Target = 'target',
NodeID = 'name', Group = 'group')
networkD3 example
data <- data_frame(
from = c("A", "A", "B", "D", "C", "D", "E", "B", "C", "D", "K", "A", "M"),
to = c("B", "E", "F", "A", "C", "A", "B", "Z", "A", "C", "A", "B", "K")
)
# Plot
p <- simpleNetwork(data, height="100px", width="100px",
Source = 1, # column number of source
Target = 2, # column number of target
linkDistance = 10, # distance between node. Increase this value to have more space between nodes
charge = -900, # numeric value indicating either the strength of the node repulsion (negative value) or attraction (positive value)
fontSize = 14, # size of the node names
fontFamily = "serif", # font og node names
linkColour = "#666", # colour of edges, MUST be a common colour for the whole graph
nodeColour = "#69b3a2", # colour of nodes, MUST be a common colour for the whole graph
opacity = 0.9, # opacity of nodes. 0=transparent. 1=no transparency
zoom = T # Can you zoom on the figure?
)
simpleNetwork
src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
networkData <- data.frame(src, target)
simpleNetwork(networkData)
forceNetwork
data(MisLinks)
data(MisNodes)
forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group", opacity = 0.4)
sankeyNetwork
URL <- "https://raw.githubusercontent.com/christophergandrud/d3Network/sankey/JSONdata/energy.json"
Energy <- RCurl::getURL(URL, ssl.verifypeer = FALSE)
EngLinks <- JSONtoDF(jsonStr = Energy, array = "links")
EngNodes <- JSONtoDF(jsonStr = Energy, array = "nodes")
sankeyNetwork(Links = EngLinks, Nodes = EngNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
fontSize = 12, nodeWidth = 30)
diagonalNetwork
Flare <- RCurl::getURL("https://gist.githubusercontent.com/mbostock/4063550/raw/a05a94858375bd0ae023f6950a2b13fac5127637/flare.json")
Flare <- rjson::fromJSON(Flare)
diagonalNetwork(List = Flare, fontSize = 10, opacity = 0.9, margin=0)
radialNetwork
Flare <- RCurl::getURL("https://gist.githubusercontent.com/mbostock/4063550/raw/a05a94858375bd0ae023f6950a2b13fac5127637/flare.json")
Flare <- rjson::fromJSON(Flare)
radialNetwork(List = Flare, fontSize = 10, opacity = 0.9, margin=0)
dendroNetwork
hc <- hclust(dist(USArrests), "ave")
dendroNetwork(hc, height = 600)